home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / net / bind-contrib.tar.gz / bind-contrib.tar / contrib / msql / dnswalk < prev    next >
Text File  |  1996-10-25  |  14KB  |  472 lines
  1. #!/usr/local/bin/perl
  2. # dnswalk    Walk through a DNS tree, pulling out zone data and
  3. # dumping it in a directory tree
  4. #
  5. # $Id: dnswalk,v 8.1 1996/10/25 04:57:41 vixie Exp $
  6. #
  7. # check data collected for legality using standard resolver
  8. #
  9. # invoke as dnswalk domain > logfile
  10. # Options:
  11. #    -r    Recursively descend subdomains of domain
  12. #    -f    Force a zone transfer, ignore existing axfr file
  13. #    -i    Suppress check for invalid characters in a domain name.
  14. #    -a    turn on warning of duplicate A records.
  15. #    -d    Debugging
  16. #    -m    Check only if the domain has been modified.  (Useful only if
  17. #          dnswalk has been run previously.)
  18. #    -F    Enable "facist" checking.  (See man page)
  19. #    -l    Check lame delegations
  20. #    -D dir  Use 'dir' as base directory for saved axfr files
  21.  
  22. require "getopts.pl";
  23.  
  24. do Getopts("D:rfiadmFl");
  25.  
  26. # Where all zone transfer information is saved.  You can change this to
  27. # something like /tmp/dnswalk if you don't want to clutter up the current
  28. # directory
  29. if ($opt_D) {
  30.     $basedir = $opt_D;
  31. } else {
  32.     $basedir = ".";
  33. }
  34. ($domain = $ARGV[0]) =~ tr/A-Z/a-z/;
  35. if ($domain !~ /\.$/) {
  36.     die "Usage: dnswalk domain\ndomain MUST end with a '.'\n";
  37. }
  38. if (! -d $basedir) {
  39.     mkdir($basedir,0777) || die "Cannot create $basedir: $!\n";
  40. }
  41.  
  42. &dowalk($domain);
  43.  
  44. exit;
  45.  
  46. sub dowalk {
  47.     local (@subdoms);
  48.     local (@sortdoms);
  49.     local ($domain)=$_[0];
  50.     $modified=0;
  51. #    ($file,@subdoms)=&doaxfr($domain);  /* perl bug */
  52.     @subdoms=&doaxfr($domain);
  53.     $file=shift(@subdoms);
  54.     if ($file && !($opt_m && !$modified)) {
  55.         &checkfile($file,$domain);
  56.     }
  57.     else {
  58.         print STDERR "skipping...\n";
  59.     }
  60.     @sortdoms = sort byhostname @subdoms;
  61.     local ($subdom);
  62.     if ($opt_r) {
  63.         foreach $subdom (@sortdoms) {
  64.             &dowalk($subdom);
  65.         }
  66.     }
  67. }
  68. # try to get a zone transfer, trying each listed authoritative server if
  69. # if fails.
  70. sub doaxfr {
  71.     local ($domain)=@_[0];
  72.     local (%subdoms)=();
  73.     local ($subdom);
  74.     local ($serial);
  75.     local ($foundsoa)=0;    # attempt to make up for dig's poor 
  76.                 # error handling
  77.     ($path=&host2path($domain)) =~ tr/A-Z/a-z/;
  78.     local(@servers) = &getauthservers($domain);
  79.     &printerr("warning: $domain has only one authoritative nameserver\n") if (scalar(@servers) == 1);
  80.     &printerr("warning: $domain has NO authoritative nameservers!\n") if (scalar(@servers) == 0);
  81.     if ((-f "$basedir/$path/axfr") && (!$main'opt_f)) {
  82.         open(DIG,"<$basedir/$path/axfr") || die "cannot open $basedir/$path/axfr: $!\n";
  83.         while (<DIG>) {
  84.             chop;
  85.             if (/(\d+)\s*; ?serial/) {
  86.                 $serial=$1;
  87.             }
  88.             if (/(\S+)\s*\d+\s+NS/) {
  89.         $subdom = $1;
  90.                 $subdom =~ tr/A-Z/a-z/;
  91.                 if ((!&equal($subdom,$domain)) && ( !$subdoms{$subdom})) {
  92.                     $subdoms{$subdom}=1;
  93.                 }
  94.             }
  95.         }
  96.         # if there's no serial number in file, assume it is corrupt
  97.         if ($serial) {
  98.             foreach $server (@servers) {
  99.                 $authserno=&getserno($domain,$server);
  100.                 last if ($authserno);
  101.             }
  102.             if ($authserno <= $serial) {
  103.                 print STDERR "Using existing zone transfer info for $domain\n";
  104.                 return ("$basedir/$path/axfr", keys %subdoms);
  105.             }
  106.         }
  107.     }
  108.     &mkdirpath($path);
  109.     SERVER:
  110.     foreach $server (@servers) {
  111.     $foundsoa=0;
  112.         $SIG{'INT'}="nop;";
  113.         print STDERR "Getting zone transfer of $domain from $server...";
  114.         open(DIG,"dig axfr $domain \@$server 2>/dev/null |");
  115.         open(DIGOUT,">$basedir/$path/axfr") || die "cannot open $basedir/$path/axfr: $!\n";
  116.     @subdoms=undef;
  117.         while (<DIG>) {
  118.             if (/(\S+)\s*\d+\s+NS/) {
  119.         $subdom = $1;
  120.                 $subdom =~ tr/A-Z/a-z/;
  121.                 if ((!&equal($subdom,$domain)) && ( !$subdoms{$subdom})) {
  122.                     $subdoms{$subdom}=1;
  123.                 }
  124.             }
  125.             elsif (/\S+\s*\d+\s+SOA/) {
  126.                 $foundsoa=1;
  127.             }
  128.             print DIGOUT $_;
  129.         }
  130.         if ($? || !$foundsoa) {
  131.             print STDERR "failed.\n";
  132.             close(DIGOUT);
  133.             next SERVER;
  134.         }
  135.         print STDERR "done.\n";
  136.         close(DIGOUT);
  137.         close(DIG);
  138.         last SERVER;
  139.     } # foreach #
  140.     $SIG{'INT'}=undef;
  141.     if ($? || !$foundsoa) {
  142.         print STDERR "All zone transfer attempts of $domain failed\n";
  143.         print "Cannot check $domain: no available nameservers!\n";
  144.         unlink("$basedir/$path/axfr");
  145.         &rmdirpath($path);
  146.         return undef;
  147.     }
  148.     $modified=1;
  149.     return ("$basedir/$path/axfr", keys %subdoms);
  150. }
  151.  
  152. # returns "edu/psu/pop" given "pop.psu.edu"
  153. sub host2path {
  154.     join('/',reverse(split(/\./,$_[0])));
  155. }
  156.  
  157. # makes sure all directories exist in "foo/bar/baz"
  158. sub mkdirpath {
  159.     local (@path)=split(/\//,$_[0]);
  160.     local ($dir)=$basedir;
  161.     foreach $p (@path) {
  162.     $dir .= "/".$p;
  163.     if (! -d $dir) {
  164.             mkdir($dir, 0777) || die "Cannot mkdir $dir: $!\n";
  165.     }
  166.     }
  167. }
  168.  
  169. # remove empty directories in path
  170. sub rmdirpath {
  171.     local (@path)=split(/\//,$_[0]);
  172.     local (@dirs);
  173.     local ($dir)=$basedir;
  174.     foreach $p (@path) {
  175.       push(@dirs, ($dir .= "/".$p));
  176.     }
  177.     foreach $p (reverse(@dirs)) {
  178.         last if !rmdir($p);
  179.     }
  180. }
  181.  
  182. sub getserno {
  183.     local ($serno)="";
  184.     $SIG{'INT'}="nop;";
  185.     open(DIG,"dig soa $_[0] \@$_[1] 2>/dev/null|");
  186.     while (<DIG>) {
  187.         if (/(\d+)\s*; ?serial/) { 
  188.             $serno=$1;
  189.         }
  190.     }
  191.     close(DIG);
  192.     $SIG{'INT'}=undef;
  193.     return $serno;
  194. }
  195.  
  196.  
  197. sub getauthservers {
  198.     local ($domain)=$_[0];
  199.     local ($master)=&getmaster($domain);
  200.     local ($foundmaster)=0;
  201.     local ($s);
  202.     open(DIG,"dig +noau ns $_[0] 2>/dev/null|");
  203.     local(@servers)=();
  204.     local(%servhash)=();
  205.     while (<DIG>) {
  206.         chop;
  207.     tr/A-Z/a-z/;
  208.         if (/\S+\s+\d+\s+ns\s+(\S+)/) {
  209.         $s=$1;
  210.         if (&equal($s,$master)) {
  211.         $foundmaster=1;   # make sure the master is at the top
  212.         } else {
  213.                 push(@servers,$s) if ($servhash{$s}++<1);
  214.         }
  215.         }
  216.     }
  217.     close(DIG);
  218.     if ($foundmaster) {
  219.     unshift(@servers,$master);
  220.     }
  221.     return @servers;
  222. }
  223.  
  224.  
  225. sub getmaster {  # return 'master' server for zone
  226.     local ($master)="";
  227.     $SIG{'INT'}="nop;";
  228.     open(DIG,"dig soa $_[0] 2>/dev/null|");
  229.     while (<DIG>) {
  230.     tr/A-Z/a-z/;
  231.         if (/.*\t\d+\tsoa\t(\S+) /) { 
  232.             $master=$1;
  233.         }
  234.     }
  235.     close(DIG);
  236.     $SIG{'INT'}=undef;
  237.     return $master;
  238. }
  239.  
  240. # open result of zone tranfer and check lots of nasty things
  241. # here's where the fun begins
  242. sub checkfile {
  243.     open(FILE,"<$_[0]") || die "Cannot open $_[0]: $!\n";
  244.     undef $errlist;
  245.     print "Checking $domain\n";
  246.     local (%glues)=();    # look for duplicate glue (A) records
  247.     local ($name, $aliases, $addrtype, $length, @addrs);
  248.     local ($prio,$mx);
  249.     local ($soa,$contact);
  250.     local ($lastns);    # last NS record we saw
  251.     local (@keys);    # temp variable
  252.     $soa=undef;
  253.     $doubledom = $domain . $domain;
  254.     $doubledom =~ s/(\W)/\\\1/g;    # quote string so it's a regexp
  255.     while (<FILE>) {
  256.         chop;
  257.         if (/^;/) {
  258.             if (/(.*[Ee][Rr][Rr][Oo][Rr].*)/) {
  259.                 # print any dig errors
  260.                 print $1 ."\n";
  261.                 next;
  262.             }
  263.         }
  264.         next if /^$/;    # skip blanks
  265.     # check to see if there is a "foo.bar.baz.bar.baz."
  266.     # probably a trailing-dot death.
  267.     if (/$doubledom/) {
  268.         &printerr(" $_: domain occurred twice, forgot trailing '.'?\n");
  269.     }
  270.         split(/\t/);
  271.         # 0=key 2=rrtype 3=value (4=value if 2=MX)
  272.         next if ($_[0] =~ /;/);
  273.     # complain only for mail names
  274.         if (($_[0] =~ /[^\*][^-A-Za-z0-9.]/) && (!$opt_i) && (($_[2] eq "A") || ($_[2] eq "MX"))) {
  275.             &printerr(" $_[0]: invalid character(s) in name\n");
  276.         }
  277.         if ($_[2] eq "SOA") {
  278.             print STDERR 's' if $opt_d;
  279.         if (! $soa) {  # avoid duplicate SOA's.  Argh.
  280.                ($soa,$contact) = $_[3] =~ /(\S+)\s+(\S+)/;
  281.                print "SOA=$soa    contact=$contact\n";
  282.         }
  283.         } elsif ($_[2] eq "PTR") {
  284.             print STDERR 'p' if $opt_d;
  285.             if (scalar((@keys=split(/\./,$_[0]))) == 6 ) {
  286.                 # check if forward name exists, but only if reverse is
  287.                 # a full IP addr
  288.                 # skip ".0" networks
  289.                 if ($keys[0] ne "0") {
  290.                     if (!(($name, $aliases, $addrtype, $length, @addrs)=gethostbyname($_[3])) && !$?) {
  291.                         &printerr(" gethostbyname($_[3]): $!\n");
  292.                     }
  293.                     else {
  294.                         if (!$name) {
  295.                             &printerr(" $_[0] PTR $_[3]: unknown host\n");
  296.                         }
  297.                         elsif (!&equal($name,$_[3])) {
  298.                             &printerr(" $_[0] PTR $_[3]: CNAME (to $name)\n");
  299.                         }    
  300.                         elsif (!&matchaddrlist($_[0])) {
  301.                             &printerr(" $_[0] PTR $_[3]: A record not found\n");
  302.                         }
  303.                     }
  304.                 }
  305.             }
  306.         } elsif (($_[2] eq "A") ) {
  307.             print STDERR 'a' if $opt_d;
  308. # check to see that a reverse PTR record exists
  309.             if (!(($name,$aliases,$addrtype,$length,@addrs)=gethostbyaddr(pack('C4', split(/\./,$_[3])),2)) && !$?) {
  310.                 &printerr(" gethostbyaddr($_[3]): $!\n");
  311.             }
  312.             else {
  313.                 if (!$name) {
  314.             # hack - allow RFC 1101 netmasks encoding
  315.             if ( $_[3] !=~ /^255/) {
  316.                         &printerr(" $_[0] A $_[3]: no PTR record\n");
  317.             }
  318.                 }
  319.                 elsif ($opt_F && !&equal($name,$_[0])) {
  320.                     &printerr(" $_[0] A $_[3]: points to $name\n") if ((split(/\./,$name))[0] ne "localhost");
  321.                 }
  322.                 if ($main'opt_a) {
  323.                     # keep list in %glues, report any duplicates
  324.                     if ($glues{$_[3]} eq "") {
  325.                         $glues{$_[3]}=$_[0];
  326.                     }
  327.                     elsif (($glues{$_[3]} eq $_[0]) && (!&equal($lastns,$domain))) {
  328.                             &printerr(" $_[0]: possible duplicate A record (glue of $lastns?)\n");
  329.                     }
  330.                 }
  331.             }
  332.         } elsif ($_[2] eq "NS") {
  333.             $lastns=$_[0];
  334.             print STDERR 'n' if $opt_d;
  335.             # check to see if object of NS is real
  336.             &checklamer($_[0],$_[3]) if ($main'opt_l);
  337.             if (!(($name, $aliases, $addrtype, $length, @addrs)=gethostbyname($_[3])) && !$?) {
  338.                 &printerr(" gethostbyname($_[3]): $!\n");
  339.             }
  340.             else {
  341.                 if (!$name) {
  342.                     &printerr(" $_[0] NS $_[3]: unknown host\n");
  343.                 } elsif (!&equal($name,$_[3])) {
  344.                     &printerr(" $_[0] NS $_[3]: CNAME (to $name)\n");
  345.                 }
  346.             }
  347.         } elsif ($_[2] eq "MX") {
  348.             print STDERR 'm' if $opt_d;
  349.             # check to see if object of mx is real
  350.             ($prio,$mx)=split(/ /,$_[3]);
  351.             if (!(($name, $aliases, $addrtype, $length, @addrs)=gethostbyname($mx)) && !$?) {
  352.                 &printerr(" gethostbyname($mx): $!\n");
  353.             }
  354.             else {
  355.                 if (!$name) {
  356.                     &printerr(" $_[0] MX $_[3]: unknown host\n");
  357.                 }
  358.                 elsif (!&equal($name,$mx)) {
  359.                     &printerr(" $_[0] MX $_[3]: CNAME (to $name)\n");
  360.                 }
  361.             }
  362.         } elsif ($_[2] eq "CNAME") {
  363.             print STDERR 'c' if $opt_d;
  364.             if (!(($name, $aliases, $addrtype, $length, @addrs)=gethostbyname($_[3])) && !$?) {
  365.                 &printerr(" gethostbyname($_[3]): $!\n");
  366.             }
  367.             else {
  368.                 if (!$name) {
  369.                     &printerr(" $_[0] CNAME $_[3]: unknown host\n");
  370.                 } elsif (!&equal($name,$_[3])) {
  371.                     &printerr(" $_[0] CNAME $_[3]: CNAME (to $name)\n");
  372.                 }
  373.             }
  374.         }
  375.     }
  376.     print STDERR "\n" if $opt_d;
  377.     close(FILE);
  378. }
  379.  
  380. # prints an error message, suppressing duplicates
  381. sub printerr {
  382.     local ($err)=$_[0];
  383.     if ($errlist{$err}==undef) {
  384.     print $err;
  385.     print STDERR "!" if $opt_d;
  386.     $errlist{$err}=1;
  387.     } else {
  388.     print STDERR "." if $opt_d;
  389.     }
  390. }
  391.  
  392. sub equal {
  393.     # Do case-insensitive string comparisons
  394.     local ($one)= $_[0];
  395.     local ($two)= $_[1];
  396.     $stripone=$one;
  397.     if (chop($stripone) eq '.') {
  398.     $one=$stripone;
  399.     }
  400.     $striptwo=$two;
  401.     if (chop($striptwo) eq '.') {
  402.     $two=$striptwo;
  403.     }
  404.     $one =~ tr/A-Z/a-z/;
  405.     $two =~ tr/A-Z/a-z/;
  406.     return ($one eq $two);
  407. }
  408.  
  409. sub matchaddrlist {
  410.     local($match)=pack('C4', reverse(split(/\./,$_[0],4)));
  411.     local($found)=0;
  412.     foreach $i (@addrs) {
  413.         $found=1 if ($i eq $match);
  414.     }
  415.     return $found;
  416. }
  417.  
  418. # there's a better way to do this, it just hasn't evolved from
  419. # my brain to this program yet.
  420. sub byhostname {
  421.     @c = reverse(split(/\./,$a));
  422.     @d = reverse(split(/\./,$b));
  423.     for ($i=0;$i<=(($#c > $#d) ? $#c : $#d) ;$i++) {
  424.         next if $c[$i] eq $d[$i];
  425.         return -1 if $c[$i] eq "";
  426.         return  1 if $d[$i] eq "";
  427.         if ($c[$i] eq int($c[$i])) {
  428.             # numeric
  429.             return $c[$i] <=> $d[$i];
  430.         }
  431.         else {
  432.             # string
  433.             return $c[$i] cmp $d[$i];
  434.         }
  435.     }
  436.     return 0;
  437. }
  438.  
  439. sub checklamer {
  440.     local ($isauth)=0;
  441.     local ($error)=0;
  442.     # must check twice, since first query may be authoritative
  443.     # trap stderr here and print if non-empty
  444.     open(DIG,"dig soa +noaa $_[0] \@$_[1] 2>&1 1>/dev/null |");
  445.     while (<DIG>) {
  446.         print " $_[0] NS $_[1]: nameserver error (lame?):\n" if !$error;
  447.     print;
  448.     $error=1;
  449.     }
  450.     close(DIG);
  451.     return if $error;
  452.     open(DIG,"dig soa +noaa $_[0] \@$_[1] 2>/dev/null|");
  453.     while (<DIG>) {
  454.         if (/status: NXDOMAIN/) { 
  455.             $isauth=0;
  456.         last;
  457.         }
  458.         if (/status: SERVFAIL/) { 
  459.             $isauth=0;
  460.         last;
  461.         }
  462.         if (/;; flags.*aa.*;/) { 
  463.             $isauth=1;
  464.         }
  465.     }
  466.     if (!$isauth) {
  467.         print " $_[0] NS $_[1]: lame NS delegation\n";
  468.     }
  469.     close(DIG);
  470.     return;
  471. }
  472.